home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1996 March / EnigmA AMIGA RUN 05 (1996)(G.R. Edizioni)(IT)[!][issue 1996-03][Skylink CD IV].iso / earcd / comm2 / msgsplit.lha / MsgSplit.thor < prev   
Text File  |  1995-09-15  |  5KB  |  172 lines

  1. /* $VER: MsgSplit.thor 1.3 (14.9.95)
  2. **
  3. ** Written by Stelios Melissakis for Thor 2.x.
  4. **
  5. **
  6. ** Many-many thanks to Kjell Irgens & the rest of Thor Team :)
  7. **
  8. **/
  9.  
  10. Options Results
  11.  
  12. Arg MaxSize .
  13.  
  14. Signal on Syntax
  15. Signal on Halt
  16. Signal on Break_C
  17.  
  18. If (MaxSize = '' | MaxSize = '?') Then
  19. Do
  20.   Say 'MsgSplit.thor v1.3 (14.9.95)'
  21.   Say '© 1995 Stelios Melissakis'CR
  22.   Say 'Usage: MsgSplit.thor MAXSIZE/A'
  23.   Exit(0)
  24. End
  25.  
  26. CR = '0a'x
  27.  
  28. /* You can change these two variables   */
  29. /* But be careful!                      */
  30.  
  31. ContNextMsg = CR || '<< Continued in Next Message >>' || CR
  32. ContPrevMsg = '<< Continued from Previous Message >>'
  33.  
  34. /* No more user changes, after this line, please :) */
  35.  
  36. Eve_EnterMsg = 0
  37. Eve_ReplyMsg = 1
  38. EDB_Deleted = 0
  39. UT_MsgFile = 1
  40.  
  41. Drop BBSData.
  42. Drop EventData.
  43. Drop EventTags.
  44. Drop UniqueStem.
  45. Drop CurStem.
  46.  
  47. Window = 0
  48. CurMsg = 0
  49.  
  50. adrstr = Address() || ' ' || Show('P',,)
  51. If Pos('THOR.',adrstr) > 0 Then
  52.    ThorPort = Word(SubStr(adrstr, Pos('THOR.',adrstr)),1)
  53. Else 
  54. Do
  55.    Say 'No THOR port found!'
  56.    Exit(0)
  57. End
  58.  
  59. If ~Show('l','rexxsupport.library') Then
  60.     If ~AddLib('rexxsupport.library',0,-30) Then
  61.         Exit(25)
  62.  
  63. If ~Show('p', 'BBSREAD') Then
  64. Do
  65.   Address Command 
  66.   "Run >NIL: `GetEnv THOR/THORPath`bin/LoadBBSRead"
  67.   "WaitForPort BBSREAD"
  68. End
  69.  
  70. Address(ThorPort)
  71. CurrentSystem CurStem
  72. If (rc = 30) Then Call Fail
  73.  
  74. Address("BBSREAD")
  75. GetBBSData '"'CurStem.BBSName'"' Stem BBSData
  76. If (rc ~= 0) Then Call Fail
  77.  
  78. If BBSData.NumEvents = "BBSDATA.NUMEVENTS" Then Exit(0)
  79.  
  80. Address(ThorPort)
  81. OpenProgress Title '"Splitting messages"' Total BBSData.NumEvents ProgressCharWidth 40
  82. If (rc = 0) Then Window = Result
  83. Else Call Fail
  84.  
  85. Do n = BBSData.FirstEvent To BBSData.LastEvent
  86.    Address("BBSREAD")
  87.    ReadBREvent bbsname '"'CurStem.BBSName'"' EventNR n TagsStem EventTags DataStem EventData
  88.    If (rc ~= 0) Then Call Fail
  89.    If (~BITTST(EventData.Flags, EDB_Deleted)) Then CurMsg = CurMsg + 1
  90.    If (~BITTST(EventData.Flags, EDB_Deleted) & ((EventData.EventType = Eve_EnterMsg) | (EventData.EventType = Eve_ReplyMsg))) Then 
  91.    Do
  92.       FName = BBSData.BBSPath || EventTags.MsgFile
  93.       FSize = FileSize(FName)
  94.       If FSize > MaxSize Then 
  95.       Do
  96.          Drop WtStem.
  97.          Pieces = FSize % MaxSize
  98.          If (((FSize / MaxSize) - (FSize % MaxSize)) ~= 0) Then Pieces = Pieces + 1
  99.          bc = 1
  100.          If Open(Source, FName, 'R') Then
  101.          Do
  102.             Do Until EOF(Source)
  103.                If ~Open(Dest, 'T:Thor_TMP_Msg', 'W') Then Call Fail
  104.                If bc > 1 Then Call WriteLn(Dest, ContPrevMsg || ' (' || bc || '/' || Pieces || ')' CR)
  105.                TotSize = 0
  106.                Do Until (TotSize > (MaxSize - 170)) | EOF(Source)
  107.                   TotSize = TotSize + WriteLn(Dest, ReadLn(Source))
  108.                End
  109.                If ~EOF(Source) Then Call WriteLn(Dest, ContNextMsg)
  110.                Call Close(Dest)
  111.                UniqueMsgFile BBSName '"'CurStem.BBSName'"' Stem UniqueStem UseTag UT_MsgFile FromFile 'T:Thor_TMP_Msg'
  112.                If (rc ~= 0) Then Call Fail
  113.                WtStem.ToName = EventTags.ToName
  114.                WtStem.Subject = EventTags.Subject
  115.                WtStem.Conference = EventTags.Conference
  116.                WtStem.MsgFile = UniqueStem.FilePart
  117.                WtStem.Private = EventTags.Private
  118.                WtStem.Date = EventTags.Date
  119.                WtStem.RefNr = EventTags.RefNr
  120.                WtStem.RefOrginalNr = EventTags.RefOrginalNr
  121.                If EventTags.PGPSignID ~= "EVENTTAGS.PGPSIGNID" Then WtStem.PGPSignID = EventTags.PGPSignID
  122.                If EventTags.PGPEncryptID ~= "EVENTTAGS.PGPENCRYPTID" Then WtStem.PGPEcryptID = EventTags.PGPEcryptID
  123.                WriteBREvent BBSName '"'CurStem.BBSName'"' Event EventData.EventType Stem WtStem
  124.                If (rc ~= 0) Then Call Fail
  125.                bc = bc + 1
  126.             End
  127.             Call Close(Source)
  128.          End
  129.          Else Call Fail
  130.          UpdateBREvent BBSname '"'CurStem.BBSName'"' EventNr n SetDeleted
  131.          If (rc ~= 0) Then Call Fail
  132.       End
  133.    End
  134.    Address(ThorPort)
  135.    UpdateProgress Req Window Current CurMsg PT '"Message 'CurMsg' of 'BBSData.NumEvents'(OrgEvent:'n')"'
  136.    If (rc ~= 0) Then Call Fail
  137. End
  138.  
  139. Fail:
  140. Syntax:
  141.   Signal Off Syntax
  142.   If (rc >30) Then Say 'Error in line 'SIGL': ' ErrorText(rc) ||CR|| SourceLine(SIGL)
  143.   If Thor.LastError ~= 'THOR.LASTERROR' Then Say Thor.LastError
  144.   If BBSRead.LastError ~= 'BBSREAD.LASTERROR' Then Say BBSRead.LastError
  145. Halt:
  146. Break_C:
  147.   FileSrch = Show('F',,)
  148.   If Pos('SOURCE',FileSrch) ~= 0 Then Call Close(Source)
  149.   If Pos('DEST',FileSrch) ~= 0 Then Call Close(Dest)
  150.   If (Window ~= 0) Then
  151.   Do
  152.     Address(ThorPort)
  153.     CloseProgress Req Window
  154.     Window = 0
  155.   End
  156.   If Exists("T:Thor_TMP_Msg") Then
  157.      Call Delete("T:Thor_TMP_Msg")
  158. Exit(0)
  159.  
  160. /***************************************************************************/
  161. /*                               Procedures                                */
  162. /***************************************************************************/
  163.  
  164. FileSize: Procedure
  165.   Arg fn
  166.   FData = StateF(fn)
  167.   FSpc = Pos(' ', FData)
  168.   LSpc = Pos(' ', FData, FSpc + 1)
  169. Return SubStr(FData, FSpc+1, LSpc-FSpc-1)
  170.  
  171. /***************************************************************************/
  172.